home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_1 / cubic < prev    next >
Text File  |  1995-03-31  |  4KB  |  117 lines
  1. Article 4740 of comp.sys.handhelds:
  2. Path: en.ecn.purdue.edu!noose.ecn.purdue.edu!samsung!sdd.hp.com!elroy.jpl.nasa.gov!decwrl!pa.dec.com!shlump.nac.dec.com!jareth.enet.dec.com!edp
  3. From: edp@jareth.enet.dec.com (Eric Postpischil (Always mount a scratch monkey.))
  4. Newsgroups: comp.sys.handhelds
  5. Subject: Cubic and quartic polynomials
  6. Message-ID: <20700@shlump.nac.dec.com>
  7. Date: 4 Mar 91 16:16:38 GMT
  8. Sender: newsdaemon@shlump.nac.dec.com
  9. Reply-To: edp@jareth.enet.dec.com (Eric Postpischil (Always mount a scratch monkey.))
  10. Organization: Digital Equipment Corporation
  11. Lines: 102
  12.  
  13. Here are routines CUBIC and QUARTIC which solve cubic and quartic equations,
  14. similar to the way that the QUAD function solves quadratic equations.  The
  15. use for both is the same as QUAD:
  16.  
  17.     'symbolic1' 'global' -> 'symbolic2'
  18.  
  19. These routines are also similar to QUAD in that they compute a Taylor's series
  20. of the appropriate degree (courtesy of PCOEF, previously posted by William
  21. C. Wickes) and honor the principal values flag (-1).
  22.  
  23. The solutions are the exact algebraic solutions, so they will find complex
  24. roots and duplicate roots.  The routines ABC and ABCD are for internal use but
  25. might be usable anyway -- they take three or four coefficients, as in a, b, and
  26. c of x^3+a*x^2+b*x+c or a, b, c, and d for the quartic, and return the solution
  27. as an expression.  If you enter A B C D ABCD, you will get an algebraic that
  28. represents the general solution for quartic equations.  It's 3,153 bytes and
  29. takes thousands more to display.  (I only had 10Kb free; that wasn't enough to
  30. hold the algebraic and display it.)
  31.  
  32. The programs N1 and S12 will take the general solution of a cubic or quartic,
  33. respectively, and substitute the three or four combinations of values for the
  34. n1 or s1 and s2 variables, returning the general solution and the three or
  35. four specific solutions to the stack.
  36.  
  37.  
  38.                 -- edp (Eric Postpischil)
  39.                 "Always mount a scratch monkey."
  40.  
  41.  
  42. %%HP: T(3)A(D)F(.);
  43. DIR
  44. CUBIC
  45. \<< \-> var \<<
  46.     EQ\-> - var 3 PCOEF LIST\-> DROP \-> a b c d \<<
  47.         var b a / c a / d a / PQR =
  48.     \>>
  49. \>> \>>
  50. QUARTIC
  51. \<< \-> var \<<
  52.     EQ\-> - var 4 PCOEF LIST\-> DROP \-> a b c d e \<<
  53.         var b a / c a / d a / e a / ABCD =
  54.     \>>
  55. \>> \>>
  56. PQR
  57. \<< \-> p q r \<<
  58.     q p SQ 3 / - 2 p 3 ^ * 9 p * q * - 27 / r + OVER -3 / \v/ 2 *
  59.     ABM p 3 / -
  60. \>> \>>
  61. ABM
  62. \<< \-> a b m \<<
  63.     3 b * a m * / 'COS(ABM)' = 'ABM' ISOL EQ\-> SWAP DROP
  64.     { 's1*&A' '&A' } \|^MATCH DROP 3 / COS m *
  65. \>> \>>
  66. ABCD
  67. \<< RCLF \-> a b c d f \<<
  68.     b NEG a c * 4 d * - 4 b * d * a SQ d * - c SQ - -1 SF PQR f STOF
  69.     \-> y \<< y b - a SQ 4 / + \v/ \-> R \<<
  70.         3 a SQ * 4 / R SQ - 2 b * -
  71.         R 0 \=/
  72.         4 a * b * 8 c * - a 3 ^ - 4 R * /
  73.         y SQ 4 d * - \v/ 2 *
  74.         IFTE
  75.         DUP2 + \v/ 2 / 3 ROLLD - \v/ 2 /
  76.         \-> D E \<<
  77.             a -4 / R 2 / IF -1 FC? THEN 's1' * END +
  78.             IF -1 FC? THEN 's1>0' ELSE 1 END
  79.             D E IFTE
  80.             IF -1 FC? THEN 's2' * END +
  81.         \>>
  82.     \>> \>>
  83. \>> \>>
  84. PCOEF
  85. \<<
  86.    3   DUPN   TYPE   SWAP   TYPE   ROT
  87.    TYPE   3   \->LIST   { 0   6   9 }
  88.    IF   ==
  89.    THEN   DUP   1   +   \->   n
  90.       \<<   #18CEAh   SYSEVAL
  91.       SWAP
  92.          #549CCh   SYSEVAL
  93.          #74D0h   SYSEVAL
  94.          #59373h   SYSEVAL
  95.          DROP   #7497h   SYSEVAL
  96.          1   n
  97.          FOR   m   m   ROLL   COLCT
  98.          NEXT
  99.          n   \->LIST
  100.       \>>
  101.    END
  102. \>>
  103. N1
  104. \<<
  105.     DUP { n1 0 } | OVER { n1 1 } | 3 PICK { n1 2 } |
  106. \>>
  107. S12
  108. \<<
  109.     DUP { s1 1 s2 1 } |
  110.     OVER { s1 1 s2 -1 } |
  111.     3 PICK { s1 -1 s2 1 } |
  112.     4 PICK { s1 -1 s2 -1 } |
  113. \>>
  114. END
  115.  
  116.  
  117.